{-# OPTIONS -Wall #-}

--------------------------------------------------------------------------------
-- |
-- Module      :  Ochre.Compiler.Compile
-- Copyright   :  (c) Stephen Tetley 2012
-- License     :  BSD3
--
-- Maintainer  :  stephen.tetley@gmail.com
-- Stability   :  unstable
-- Portability :  GHC
--
-- Run the compiler phases.
--
--------------------------------------------------------------------------------

module Ochre.Compiler.Compile
  (

    CompilerOpts(..)
  , default_opts

  , compileOrchestra
  , compileOrchestraU
  , compileInstrument
  , debugInstrument
  , debugInstrumentF
  , testInstrument
  , testInstrumentOpt

  , optimizeSteps
  , repeatM

 
  ) where

import Ochre.Compiler.Alpha
import Ochre.Compiler.Assoc
import Ochre.Compiler.Beta
import Ochre.Compiler.CompilerMon
import Ochre.Compiler.ConstFold
import qualified Ochre.Compiler.CsoundSyntax as C
import qualified Ochre.Compiler.CsoundTrans as C
import Ochre.Compiler.ElimLet
import Ochre.Compiler.Syntax
import Ochre.Compiler.Utils


import Text.PrettyPrint                         -- package: pretty

import Control.Monad
import Control.Applicative

data CompilerOpts = CompilerOpts { optimize_reps :: Int }
  deriving (Eq,Show)

default_opts :: CompilerOpts
default_opts = CompilerOpts
    { optimize_reps     = 3
    }


-- | runs in the Error monad...
--
compileOrchestra :: CompilerOpts -> Orchestra -> Either ErrMsg String
compileOrchestra opts (Orchestra { orch_globals = gvars
                                 , orch_instrs = insts }) = do
    globals   <- runCompiler $ mapM C.global gvars
    cs_insts  <- mapM (runCompiler . compileInstrument opts) insts
    return $ pprint $ C.Orchestra globals cs_insts
  where
    pprint orch = let d = C.ppOrchestra orch
                  in renderStyle (style { lineLength = 300 }) 
                                 (d $+$ blank_doc) 

-- | Unsafe version of compileOrch...
--
compileOrchestraU :: CompilerOpts -> Orchestra -> String
compileOrchestraU opts orch = 
    either (';':) id $ compileOrchestra opts orch


compileInstrument :: CompilerOpts -> Instrument -> Compiler C.Instrument
compileInstrument opts (Instrument i decls expr) = 
    optimize (optimize_reps opts) expr >>= \kexpr -> 
    C.instr i decls kexpr

testInstrument :: CompilerOpts -> Instrument -> Either ErrMsg C.Instrument
testInstrument opts inst = runCompiler $ compileInstrument opts inst

debugInstrument :: Instrument -> String
debugInstrument = show . ppInstr 

debugInstrumentF :: (Expr -> Compiler Expr) -> Instrument -> Either ErrMsg String
debugInstrumentF mf (Instrument i decls expr) = 
     fmap (show . ppInstr) $ runCompiler $ 
        Instrument i decls <$> mf expr

testInstrumentOpt :: CompilerOpts -> Instrument -> Either ErrMsg Doc
testInstrumentOpt opts (Instrument i decls expr) = 
    fmap ppInstr $ runCompiler $  
      optimize (optimize_reps opts) expr >>= \kexpr -> 
      return $ Instrument i decls kexpr  

-- | Finish with an alpha rename so we get variables starting 
-- from 1.
--
optimize  :: Int -> Expr -> Compiler Expr
optimize i = alpha >=> repeatM i optimizeSteps >=> alpha

-- | In MinCaml the optimization steps are repeated as a round
-- of simplification may introduce further opportunities for
-- optimization.
--
optimizeSteps :: Expr -> Compiler Expr
optimizeSteps = elimLet <=< constFold <=< assoc <=< beta



repeatM :: Monad m => Int -> (a -> m a) -> a -> m a
repeatM count mf = go count
  where
    go i a | i <= 0    = return a
           | otherwise = mf a >>= go (i-1)


